home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / nrcobol_1e.lha / NRCOBOL1e / COBFILES / SORTCLIENT2.COB < prev    next >
Text File  |  1998-02-04  |  17KB  |  419 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.  SORTCLIENT2.
  3.       *PROGRAM DISCRIPTION.
  4.        ENVIRONMENT DIVISION.
  5.        CONFIGURATION SECTION.
  6.        SOURCE-COMPUTER.
  7.        OBJECT-COMPUTER.
  8.        INPUT-OUTPUT SECTION.
  9.        FILE-CONTROL.
  10.            SELECT CLIENT-FILE ASSIGN TO DISK
  11.            ORGANIZATION IS LINE SEQUENTIAL
  12.            ACCESS MODE  IS SEQUENTIAL
  13.            FILE STATUS  IS WS-FILE-STATUS.
  14.       *
  15.            SELECT S-CLIENT-FILE ASSIGN TO DISK
  16.            ORGANIZATION IS SEQUENTIAL
  17.            ACCESS MODE  IS SEQUENTIAL
  18.            FILE STATUS  IS WS-S-FILE-STATUS.
  19.       *
  20.            SELECT D-CLIENT-FILE ASSIGN TO DISK
  21.            ORGANIZATION IS SEQUENTIAL
  22.            ACCESS MODE  IS SEQUENTIAL
  23.            FILE STATUS  IS WS-D-FILE-STATUS.
  24.       *
  25.            SELECT SORT-CLIENT-FILE ASSIGN TO DISK.
  26.       *
  27.        DATA DIVISION.
  28.        FILE SECTION.
  29.        FD CLIENT-FILE
  30.            LABEL RECORDS STANDARD
  31.            VALUE OF FILE-ID IS "CLIENT.DAT".
  32.        01  IN-CLIENT-REC.
  33.            03  ER-CLAIM-NUMBER          PIC 999V9(4).
  34.            03  ER-CLASS-CODE            PIC 9(6).
  35.            03  ER-REGION                PIC X(4).
  36.            03  ER-PREV-CLAIMS           PIC 99.
  37.            03  ER-PREV-CLAIMS-TOTAL     PIC 9(9).
  38.            03  ER-AMOUNT-CLAIMED        PIC 9(7).
  39.       *
  40.        FD  S-CLIENT-FILE
  41.            LABEL RECORDS STANDARD
  42.            VALUE OF FILE-ID IS "SCLIENT.DAT".
  43.        01  S-CLIENT-REC.
  44.            03  ER-S-CLAIM-NUMBER          PIC 999V9(4).
  45.            03  ER-S-CLASS-CODE            PIC 9(6).
  46.            03  ER-S-REGION                PIC X(4).
  47.            03  ER-S-PREV-CLAIMS           PIC 99.
  48.            03  ER-S-PREV-CLAIMS-TOTAL     PIC 9(9).
  49.            03  ER-S-AMOUNT-CLAIMED        PIC 9(7).
  50.       *
  51.        FD  D-CLIENT-FILE
  52.            LABEL RECORDS STANDARD
  53.            VALUE OF FILE-ID IS "DCLIENT.DAT".
  54.        01  D-CLIENT-REC.
  55.            03  ER-D-CLAIM-NUMBER          PIC 999V9(4).
  56.            03  ER-D-CLASS-CODE            PIC 9(6).
  57.            03  ER-D-REGION                PIC X(4).
  58.            03  ER-D-PREV-CLAIMS           PIC 99.
  59.            03  ER-D-PREV-CLAIMS-TOTAL     PIC 9(9).
  60.            03  ER-D-AMOUNT-CLAIMED        PIC 9(7).
  61.       *
  62.        SD  SORT-CLIENT-FILE.
  63.        01  SD-CLIENT-REC.
  64.            03  SD-CLAIM-NUMBER          PIC 999V9(4).
  65.            03  SD-CLASS-CODE            PIC 9(6).
  66.            03  SD-REGION                PIC X(4).
  67.            03  SD-PREV-CLAIMS           PIC 99.
  68.            03  SD-PREV-CLAIMS-TOTAL     PIC 9(9).
  69.            03  SD-AMOUNT-CLAIMED        PIC 9(7).
  70.       *
  71.        WORKING-STORAGE SECTION.
  72.        01 WS-COUNTERS.
  73.            03 WS-PAGE-COUNT      PIC 99 VALUE 00.
  74.            03 WS-LINE-COUNT      PIC 99 VALUE 00.
  75.            03 WS-CLAIMS-TOTAL        PIC 9(9).
  76.            03 WS-CLAIMS-NUM-TOTAL    PIC 999  VALUE 1.
  77.            03 WS-AVERAGE-CLAIM       PIC 9(7).
  78.        01 WS-STOP-RUN-FLAG       PIC X  VALUE " ".
  79.        01 WS-END-FILE-FLAG       PIC X  VALUE " ".
  80.        01 WS-FILE-STATUS         PIC XX VALUE "00".
  81.        01 WS-S-FILE-STATUS       PIC XX VALUE "00".
  82.        01 WS-D-FILE-STATUS       PIC XX VALUE "00".
  83.       *
  84.        01 WS-TITLE-1.
  85.            03 FILLER  PIC X(22)  VALUE "ASSIGNMENT    10/08/89".
  86.            03 FILLER  PIC X(5)   VALUE SPACES.
  87.            03 FILLER  PIC X(26)  VALUE "FAIL SAFE INSURANCE AGENCY".
  88.            03 FILLER  PIC X(5)   VALUE SPACES.
  89.            03 WS-TITLE-DATE      PIC X(8).
  90.            03 FILLER             PIC X(7).
  91.            03 FILLER             PIC X(5)   VALUE "PAGE ".
  92.            03 WS-TITLE-PAGE-NO   PIC 99.
  93.        01 WS-TITLE-3.
  94.            03 FILLER  PIC X(29)  VALUE SPACES.
  95.            03 FILLER  PIC X(22)  VALUE "INSURANCE CLAIM REPORT".
  96.        01 WS-HEADER-4.
  97.            03 FILLER  PIC X(12)  VALUE "CLAIM NUMBER".
  98.            03 FILLER  PIC X(12)  VALUE SPACES.
  99.            03 FILLER  PIC X(6)   VALUE "REGION".
  100.            03 FILLER  PIC X(12)  VALUE SPACES.
  101.            03 FILLER  PIC X(13)  VALUE "TOTAL CLAIMED".
  102.            03 FILLER  PIC X(10)  VALUE SPACES.
  103.            03 FILLER  PIC X(15)  VALUE "AMOUNT OF CLAIM".
  104.        01 WS-HEADER-5.
  105.            03 FILLER  PIC X(13)  VALUE SPACES.
  106.            03 FILLER  PIC X(10)  VALUE "CLASS CODE".
  107.            03 FILLER  PIC X(6)   VALUE SPACES.
  108.            03 FILLER  PIC X(15)  VALUE "PREVIOUS CLAIMS".
  109.            03 FILLER  PIC X(8)   VALUE SPACES.
  110.            03 FILLER  PIC X(16)  VALUE "AVERAGED CLAIMED".
  111.        01 WS-INSURENCE-REC.
  112.            03 FILLER             PIC X(3)   VALUE SPACES.
  113.            03 FLD-CLAIM-NUMBER   PIC 999V9(4).
  114.            03 FILLER             PIC X(5)   VALUE SPACES.
  115.            03 FLD-CLASS-CODE     PIC X(6).
  116.            03 FILLER             PIC X(4)   VALUE SPACES.
  117.            03 FLD-REGION         PIC X(6).
  118.            03 FILLER             PIC X(6)   VALUE SPACES.
  119.            03 FLD-PREV-CLAIMS    PIC Z9.
  120.            03 FILLER             PIC X(5)   VALUE SPACES.
  121.            03 FLD-PREV-CLAIMS-TOTAL  PIC Z(8)9.
  122.            03 FILLER             PIC X(5)   VALUE SPACES.
  123.            03 FLD-AVG-CLAIMED    PIC Z(6)9.
  124.            03 FILLER             PIC X(5)   VALUE SPACES.
  125.            03 FLD-AMOUNT-CLAIMED PIC Z(8)9.
  126.       *
  127.        01 WS-TOTALS-1.
  128.            03 FILLER             PIC X(35)  VALUE SPACES.
  129.            03 FILLER             PIC X(22)  VALUE
  130.                          "CURRENT TOTAL CLAIMS :".
  131.            03 TOTALS-CURR-CLAIMS PIC ZZZ,ZZZ,ZZ9.
  132.        01 WS-TOTALS-2.
  133.            03 FILLER             PIC X(35)  VALUE SPACES.
  134.            03 FILLER             PIC X(22)  VALUE
  135.                          "NUMBER OF CLAIMS     :".
  136.            03 TOTALS-MAX-CLAIMS  PIC ZZ9.
  137.        01 WS-TOTALS-3.
  138.            03 FILLER             PIC X(35)  VALUE SPACES.
  139.            03 FILLER             PIC X(22)  VALUE
  140.                          "AVERAGE CLAIM        :".
  141.            03 TOTALS-AVG-CLAIMS  PIC Z,ZZZ,ZZ9.
  142.  
  143.  
  144.        01 WS-REAL-DATE.
  145.            03 WS-REAL-YEAR       PIC XX.
  146.            03 WS-REAL-MONTH      PIC XX.
  147.            03 WS-REAL-DAY        PIC XX.
  148.        01 WS-TEMP-DATE.
  149.            03 WS-TEMP-DAY        PIC XX.
  150.            03 FILLER             PIC X    VALUE  "/".
  151.            03 WS-TEMP-MONTH      PIC XX.
  152.            03 FILLER             PIC X    VALUE  "/".
  153.            03 WS-TEMP-YEAR       PIC XX.
  154.        01 WS-CLIENT-REC.
  155.            03  WS-CLAIM-NUMBER          PIC 999V9(4).
  156.            03  WS-CLASS-CODE            PIC 9(6).
  157.            03  WS-REGION                PIC X(4).
  158.            03  WS-PREV-CLAIMS           PIC 99.
  159.            03  WS-PREV-CLAIMS-TOTAL     PIC 9(9).
  160.            03  WS-AMOUNT-CLAIMED        PIC 9(7).
  161.       *
  162.        01 WS-RESPONCE            PIC X.
  163.            88 WS-RESPONCE-S             VALUE "S" "s".
  164.            88 WS-RESPONCE-AD            VALUE "A" "a"
  165.                                               "D" "d".
  166.            88 WS-RESPONCE-A             VALUE "A" "a".
  167.            88 WS-RESPONCE-D             VALUE "D" "d".
  168.            88 WS-RESPONCE-Q             VALUE "Q" "q".
  169.       *
  170.        SCREEN SECTION.
  171.        01 BLANK-SCREEN.
  172.            03 FOREGROUND-COLOR 0 BACKGROUND-COLOR 3.
  173.            03 BLANK SCREEN.
  174.        01 BLANK-LINE.
  175.            03 BLANK LINE.
  176.        01 PROG-DISCRIPTION.
  177.        01 PRINTING-DOC-MESSG.
  178.            03 LINE 3 COLUMN 8        VALUE   "PAGE ".
  179.            03 LINE 3 COLUMN 13       PIC 99   FROM  WS-PAGE-COUNT.
  180.            03 LINE 3 COLUMN 15       VALUE
  181.                    " OF RECORD IS NOW BEING PRINTED".
  182.        01 PROG-FINISH.
  183.            03 LINE 24 COLUMN 8       VALUE
  184.                    "TASK COMPLETE".
  185.        01 MENU.
  186.            03 LINE 10 COLUMN 30 VALUE "MENU".
  187.            03 LINE 11 COLUMN 30 VALUE "----".
  188.            03 LINE 15 COLUMN 19 VALUE 
  189.                                 "PRESS 'A' to sort in ASCENDING".
  190.            03 LINE 16 COLUMN 19 VALUE 
  191.                                 "      'D' to sort in DESCENDING".
  192.            03 LINE 17 COLUMN 19 VALUE 
  193.                                 "      'S' to list to SCREEN ".
  194.            03 LINE 19 COLUMN 19 VALUE 
  195.                                 "      'Q' to quit    MENU   ".
  196.        01 SORTING.
  197.            03 LINE 22 COLUMN 19 VALUE "Sorting file.....".
  198.  
  199.        01 RESPONCE-LINE.
  200.            0